home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / ezy_comm / ezy1023.zip / EKIT102.ZIP / EZYUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-24  |  24KB  |  743 lines
  1. (* This unit is the copyrighted works of Peter Davies 1992.
  2.    Peter Davies reserves all rights on this material.  Use
  3.    of this library is granted freely, however due credit must
  4.    be given to Peter Davies.  That is, you must mention that
  5.    you used source written by Peter Davies.  No liability
  6.    whatsoever is given for this unit.  You accept all
  7.    responsibility whatsoever.
  8.  
  9.    You are hereby allowed to modify the source code, but you must NOT
  10.    distribute it in modified form.  If, you have any enhancements to this
  11.    unit for inclusion, please send them to me.
  12.  
  13.    For improvements, please contact Peter Davies Fido 3:633/152 *)
  14.  
  15. Unit ezyunit;
  16.  
  17. {$O-,F+,R-,S-,V-}
  18. Interface
  19. uses crt,dos,ezyinc;
  20.  
  21. type
  22.    msgarearecord = record
  23.       hdrfile,
  24.       txtfile    : file;
  25.       msgarea    : word;
  26.       msgrec     : messagerecord;
  27.    end;
  28.  
  29. var
  30.    msgrecfile      : file;
  31.       (* Always use this file when accessing MESSAGES.EZY
  32.          If, this file is Open EzyUnit will Utilize it.  If closed,
  33.          Ezycom will Open it, then close it *)
  34.  
  35. const
  36.    Hex : Array[$0..$F] Of Char = '0123456789abcdef';
  37.    initializedate  : boolean = true;
  38.       (* This flags whether the message write routine should initialize
  39.          the posttimedate or not (true means it should) *)
  40.    echomailentered : boolean = false;
  41.    netmailentered  : boolean = false;
  42.       (* These flags are set if Netmail and/or Echomail were entered
  43.          while this program is in operation *)
  44.    programname : string[10] = 'EzyUnit';
  45.       (* Name of program to place in origin and/or tearline *)
  46.    usetearline : boolean = true;
  47.       (* true means place the program name in the tearline
  48.          false means place the program name in the PID line *)
  49.  
  50. function  fopen(var miscfile : file;recsize : word;fmode : byte;fname : maxstr) : boolean;
  51.     (* Opens an UnTyped File, with sharing *)
  52. function  openmsgareaforread(area : word; var msgarearec : msgarearecord) : boolean;
  53.     (* Opens a Message Area for Reading *)
  54. function  openmsgareaforwrite(area : word;var msgarearec : msgarearecord) : boolean;
  55.     (* Opens a Message Area for Writing *)
  56. procedure closemsgarea(var msgarearec : msgarearecord);
  57.     (* Close a Message Area *)
  58. function  writemessage(var msgarearec : msgarearecord;var msghdrrec : msghdrrecord;var msgtxtrec) : word;
  59.     (* Writes a Message to an opened msgarea *)
  60. function  readmessage(var msgarearec : msgarearecord;
  61.                      msgtoread : word;
  62.                      var msghdrrec : msghdrrecord;
  63.                      var msgtxtrec;maxread : word;
  64.                      var numread : word) : boolean;
  65.     (* Reads a Message from an opened msgarea *)
  66. function retcombinedarea(var lastreadfile : file;
  67.                              userrecord,
  68.                              messageboard : word) : boolean;
  69. function  retlastread(var lastreadfile : file;
  70.                           userrecord,
  71.                           messageboard : word) : word;
  72. (* Returns the lastread pointer for a user in a conference
  73.    where : lastreadfile is an untyped file
  74.            userrecord   is the user record number
  75.            messageboard is the message board      *)
  76. procedure writelastread(var lastreadfile : file;
  77.                           userrecord,
  78.                           messageboard,
  79.                           lastread : word);
  80. (* Writes the lastread pointer for a user in a conference
  81.    where : lastreadfile is an untyped file
  82.            userrecord   is the user record number
  83.            messageboard is the message board
  84.            lastread     is the last read pointer to write  *)
  85. function hexbyte(b : byte) : str2;
  86.     (* Returns the Byte in Hexadecimal *)
  87. function hexword(w : word) : str4;
  88.     (* Returns the Word in Hexadecimal *)
  89. function hexlong(ww : longint) : str8;
  90.     (* Returns the Longint in Hexadecimal *)
  91. function retnetstring(var netinfo : netrecord) : str23;
  92.     (* Returns the netaddress in string form *)
  93. function lock(var f : file;pos : word;size : longint) : boolean;
  94.     (* Lock a region of the file *)
  95. function unlock(var f : file;pos : word;size : longint) : boolean;
  96.     (* Unlock a region of the file *)
  97. procedure getmsgareacount(var msgareacount : msgareacounttype);
  98.     (* Get number of messages for each area *)
  99. Implementation
  100.  
  101. uses ezycrc;
  102.  
  103. function fopen(var miscfile : file;recsize : word;fmode : byte;fname : maxstr) : boolean;
  104.  
  105. var
  106.    ioerror  : word;
  107.    filelock : boolean;
  108.    ch       : char;
  109.    timer    : boolean;
  110.  
  111. begin
  112.    fname := low2up(fname);
  113.    assign(miscfile,fname);
  114.    filemode := fmode;
  115.    {$I-}
  116.    filelock := false;
  117.    ch := #0;
  118.    timer := false;
  119.    repeat
  120.       reset(miscfile,recsize);
  121.       ioerror := ioresult;
  122.       if (ioerror = 5) then
  123.          begin
  124.             if (not filelock) and (ioerror = 5) then
  125.                begin
  126.                   (* Open a Window
  127.                   openwindow((80-length(fname))div 2 - 2,10,(80-length(fname))div 2 + 2 + length(fname),14,' File Lock ',
  128.                      configrec.popuphighlight + configrec.disppopupb * 16,
  129.                      configrec.disppopupborder + configrec.disppopupb * 16);
  130.                   textcolor(configrec.disppopupf);
  131.                   textbackground(configrec.disppopupb);
  132.                   clrscr;
  133.                   writeln;
  134.                   write(' ' + fname);
  135.                   filelock := true; *)
  136.                end;
  137.             delay(500);
  138.             if keypressed then
  139.                begin
  140.                   ch := readkey;
  141.                   if (ch = #0) then
  142.                      ch := readkey;
  143.                end;
  144.          end else
  145.       if (ioerror <> 0) then
  146.          begin
  147.             if (ioerror = 2) or (ioerror = 3) then
  148.                begin
  149.                   writeln(chr(254) + ' ',fname,' not found');
  150.                   halt(1);
  151.                end;
  152.             runerror(ioerror);
  153.          end;
  154.    until (ioerror = 0) or (ch = #27) or (timer);
  155.    {$I+}
  156. (* Close the window
  157.    if filelock then
  158.       closewindow; *)
  159.    fopen :=  (ch<>#27) and (not timer);
  160. end;
  161.  
  162.  
  163.  
  164. function hexbyte(b : byte) : str2;
  165. begin
  166.   hexbyte := hex[b shr 4] + hex[b and $F];
  167. end;
  168.  
  169. function hexword(w : word) : str4;
  170. begin
  171.   hexword := hexbyte(hi(w)) + hexbyte(lo(w));
  172. end;
  173.  
  174. function hexlong(ww : longInt) : str8;
  175. var
  176.   w : array[1..2] of word absolute ww;
  177. begin
  178.   hexlong := hexword(w[2]) + hexword(w[1]);
  179. end;
  180.  
  181. function retnetstring(var netinfo : netrecord) : str23;
  182.  
  183. var
  184.    tmp : str23;
  185.  
  186. begin
  187.    with netinfo do
  188.       begin
  189.          tmp := itos(zone) + ':' + itos(net) + '/' + itos(node);
  190.          if (point > 0) then
  191.             tmp := tmp + '.' + itos(point);
  192.       end;
  193.    retnetstring := tmp;
  194. end;
  195.  
  196.  
  197. function openmsgareaforread(area : word;var msgarearec : msgarearecord) : boolean;
  198.  
  199. var
  200.    ioerror : word;
  201.    msgrecfilestatus : byte;
  202.  
  203. begin
  204.    msgarearec.msgarea := area;
  205.    openmsgareaforread := false;
  206.    msgrecfilestatus := 0;
  207.    if (filerec(msgrecfile).mode = fmoutput) then
  208.       exit;
  209.    if (filerec(msgrecfile).mode <> fminput) and
  210.       (filerec(msgrecfile).mode <> fminout) then
  211.       begin
  212.          msgrecfilestatus := 1;
  213.          if not fopen(msgrecfile,sizeof(messagerecord),fdenynone + freadonly,
  214.             systempath + 'MESSAGES.EZY') then
  215.             exit;
  216.       end;
  217.    seek(msgrecfile,area-1);
  218.    blockread(msgrecfile,msgarearec.msgrec,1);
  219.    if (msgrecfilestatus = 1) then
  220.       close(msgrecfile);
  221.    if not (msgarearec.msgrec.typ in [localmail,allmail,echomail,netmail]) or
  222.       (area > constant.maxmess) then
  223.       exit;
  224.    if not find(retmessxxx(area,1)) then
  225.       exit;
  226.    if not find(retmessxxx(area,2)) then
  227.       begin
  228.          assign(msgarearec.hdrfile,retmessxxx(area,1));
  229.          {$I-}
  230.          erase(msgarearec.hdrfile);
  231.          ioerror := ioresult;
  232.          {$I+}
  233.          exit;
  234.       end;
  235.    if not fopen(msgarearec.hdrfile,sizeof(msghdrrecord),fdenynone + freadwrite,retmessxxx(area,1)) then
  236.       exit;
  237.    if not fopen(msgarearec.txtfile,1,fdenynone + freadonly,retmessxxx(area,2)) then
  238.       begin
  239.          close(msgarearec.hdrfile);
  240.          exit;
  241.       end;
  242.    openmsgareaforread := true;
  243. end;
  244.  
  245. function openmsgareaforwrite(area : word;var msgarearec : msgarearecord) : boolean;
  246.  
  247. begin
  248.    with msgarearec do
  249.       if not find(retmessxxx(area,1)) or not find(retmessxxx(area,2)) then
  250.          begin
  251.             assign(hdrfile,retmessxxx(area,1));
  252.             rewrite(hdrfile,1);
  253.             close(hdrfile);
  254.             assign(txtfile,retmessxxx(area,2));
  255.             rewrite(txtfile,1);
  256.             close(txtfile);
  257.          end;
  258.    openmsgareaforwrite := openmsgareaforread(area,msgarearec);
  259. end;
  260.  
  261. procedure closemsgarea(var msgarearec : msgarearecord);
  262.  
  263. var
  264.    ioerror : word;
  265.  
  266. begin
  267.    {$I-}
  268.    close(msgarearec.hdrfile);
  269.    ioerror := ioresult;
  270.    close(msgarearec.txtfile);
  271.    ioerror := ioresult;
  272.    {$I+}
  273. end;
  274.  
  275.  
  276. (* ********************************************************
  277.    **                                                    **
  278.    **          Writes a Message in the Message           **
  279.    **                    Database                        **
  280.    **                                                    **
  281.    ******************************************************** *)
  282.  
  283.  
  284. function writemessage(var msgarearec : msgarearecord;var msghdrrec : msghdrrecord;var msgtxtrec) : word;
  285.  
  286. (* To write a message, you MUST initialize EVERY field in msghdr, except for
  287.    startposition, recvtimedate and posttimedate.
  288.  
  289.    posttimedate should be initialized if initializedate is set to false
  290.  
  291.    If the message is a reply, then PREVREPLY should point
  292.    to this message being replied to, although on RETURN, PREVREPLY might
  293.    point to another message.
  294.    The function returns 0 if failure.
  295.    The function returns the message number (record+1) written if success.
  296.  
  297.    Before calling this function, if replying to a message, that message
  298.    header SHOULD be written to DISK, and then READ from DISK after the
  299.    reply, as the NEXTREPLY field might have changed (not always if it is
  300.    already used!)  That is, this function handles REPLY CHAINING!
  301.  
  302.    The MsgTxtRec it limited to a 64k message (65000 bytes).
  303.    It should NOT be NULL terminated as this unit will add a NULL
  304.    terminator.  This unit requires MSGHDR's messagelength to contain
  305.    the EXACT length of the message to be written.
  306.  
  307.    The orignet and destnet are initialized.  If using netmail, you
  308.    must fill out destnet before calling this function, but orignet
  309.    will be filled out by this procedure.
  310.  
  311.    Note this procedure only handles 64k messages, but if you write your
  312.    own, Ezycom can actually handle messages of ANY length.  But, Ezymail
  313.    can only handle messages of 32K
  314.  
  315.    200 bytes of free space should always be available in the message
  316.    text.  That is, if you pass an array of 4096 bytes across, then you
  317.    can only use upto 3896 bytes *)
  318.  
  319. type
  320.    msgtxtbuffer = array[1..65000] of char;
  321.  
  322. var
  323.    numwrote : word;
  324.    regs     : registers;
  325.    txtpos   : longint;
  326.    hdrpos   : longint;
  327.    msgtmp   : msghdrrecord;
  328.    tmpfile  : file;
  329.    tmpboolean : boolean;
  330.    msgtxtbuf  : msgtxtbuffer absolute msgtxtrec;
  331.  
  332. procedure changeaccess;
  333.  
  334. var
  335.    ioerror : word;
  336.  
  337. begin
  338.    {$I-}
  339.    repeat
  340.       reset(msgarearec.txtfile,1);
  341.       ioerror := ioresult;
  342.       if (ioerror = 5) then
  343.          delay(500) else
  344.       if (ioerror <> 0) then
  345.          runerror(ioerror);
  346.    until (ioerror = 0);
  347.    {$I+}
  348. end;
  349.  
  350. procedure makedate;
  351.  
  352. var
  353.    dt : datetime;
  354.    junk : word;
  355.  
  356. begin
  357.    if not initializedate then
  358.       exit;
  359.    getdate(dt.year,dt.month,dt.day,junk);
  360.    gettime(dt.hour,dt.min,dt.sec,junk);
  361.    msghdrrec.recvtimedate := 0;
  362.    packtime(dt,msghdrrec.posttimedate);
  363. end;
  364.  
  365. procedure domsgid(var msgidline : maxstr);
  366.  
  367. var
  368.    tmpfile : file;
  369.    domain  : domainstr;
  370.    domainlen : byte absolute domain;
  371.    Dt      : Datetime;
  372.    sec100,
  373.    junk    : word;
  374.    temp    : string[79];
  375.    tmplong : longint;
  376.  
  377. begin
  378.    getdate(dt.year,dt.month,dt.day,junk);
  379.    gettime(dt.hour,dt.min,dt.sec,sec100);
  380.    msghdrrec.recvtimedate := 0;
  381.    packtime(dt,tmplong);
  382.    if initializedate then
  383.       msghdrrec.posttimedate := tmplong;
  384.    msgidline := '';
  385.    if not fopen(tmpfile,1,fdenynone + freadonly,systempath + 'CONSTANT.EZY') then
  386.       exit;
  387.    seek(tmpfile,startofdomain + (msgarearec.msgrec.originaddress - 1)*sizeof(domainstr));
  388.    blockread(tmpfile,domain,sizeof(domainstr));
  389.    close(tmpfile);
  390.    temp := hexlong(tmplong shl 2 + (dt.sec mod 2) shl 1 + (sec100 div 50));
  391.    if (domainlen > 0) and (pos(' ',domain) > 0) then
  392.       msgidline := chr(1) + 'MSGID: "' +
  393.           retnetstring(constant.netaddress[msgarearec.msgrec.originaddress]) +
  394.           '@' + domain + '" ' + temp + chr(13) else
  395.       begin
  396.          msgidline := chr(1) + 'MSGID: ' +
  397.              retnetstring(constant.netaddress[msgarearec.msgrec.originaddress]);
  398.          if (domainlen > 0) then
  399.             msgidline := msgidline + '@' + domain;
  400.          msgidline := msgidline + ' ' + temp + chr(13);
  401.       end;
  402. end;
  403.  
  404.  
  405. procedure addbeginlines;
  406.  
  407. var
  408.    msgidline  : string[79];
  409.    pidline    : string[79];
  410.    leadstring : maxstr;
  411.    totlen     : byte;
  412.    loop       : word;
  413.  
  414. begin
  415.    pidline := #1 + 'PID: '+programname+' V1.02' + #$D;
  416.    domsgid(msgidline);
  417.    if usetearline then
  418.       leadstring := msgidline else
  419.       leadstring := pidline + msgidline;
  420.    totlen := length(leadstring);
  421.    if (totlen > 0) then
  422.       begin
  423.          move(msgtxtbuf,msgtxtbuf[totlen+1],msghdrrec.messagelength);
  424.          for loop := 1 to totlen do
  425.             msgtxtbuf[loop] := leadstring[loop];
  426.          inc(msghdrrec.messagelength,totlen);
  427.       end;
  428. end;
  429.  
  430. procedure addendlines;
  431.  
  432. var
  433.    tearline  : string[79];
  434.    endstring : maxstr;
  435.    loop      : word;
  436.  
  437. begin
  438.    if usetearline then
  439.       tearline := '--- '+programname+' '+constant.version+#$D else
  440.       tearline := '---'+#$D;
  441.    endstring := tearline + ' * Origin: ';
  442.    if (length(msgarearec.msgrec.originline) > 0) then
  443.       endstring := endstring + msgarearec.msgrec.originline else
  444.       endstring := endstring + configrec.defaultorigin;
  445.    endstring := endstring + ' ('+
  446.       retnetstring(constant.netaddress[msgarearec.msgrec.originaddress]) +
  447.       ')' + #$D;
  448.    for loop := 1 to length(endstring) do
  449.       begin
  450.          inc(msghdrrec.messagelength);
  451.          msgtxtbuf[msghdrrec.messagelength] := endstring[loop];
  452.       end;
  453. end;
  454.  
  455. procedure addtofastmail;
  456.  
  457. var
  458.    msgfast : msgfastrecord;
  459.    loop    : word;
  460.  
  461. begin
  462.    msgfast.msgboard  := msgarearec.msgarea;
  463.    msgfast.msgnumber := filesize(msgarearec.hdrfile);
  464.    msgfast.whoto     := $FFFFFFFF;
  465.    for loop := 1 to length(msghdrrec.whoto) do
  466.       msgfast.whoto  := updc32(ord(upcase(msghdrrec.whoto[loop])),msgfast.whoto);
  467.    if fopen(tmpfile,sizeof(msgfast),fdenywrite + fwriteonly,
  468.       configrec.msgpath + 'MSGFAST.BBS') then
  469.       begin
  470.          seek(tmpfile,filesize(tmpfile));
  471.          blockwrite(tmpfile,msgfast,1);
  472.          close(tmpfile);
  473.       end;
  474. end;
  475.  
  476. procedure updatemsgcount;
  477.  
  478. var
  479.    tmpword : word;
  480.    tmpfile : file;
  481.  
  482. begin
  483.    if fopen(tmpfile,sizeof(word),fdenynone + fwriteonly,
  484.       configrec.msgpath + 'MSGCOUNT.BBS') then
  485.       begin
  486.          tmpword := filesize(msgarearec.hdrfile);
  487.          seek(tmpfile,msgarearec.msgarea-1);
  488.          blockwrite(tmpfile,tmpword,1);
  489.          close(tmpfile);
  490.       end;
  491. end;
  492.  
  493. begin
  494.    writemessage := 0;
  495.    if (msghdrrec.messagelength > 65000) or (msghdrrec.messagelength = 0) then
  496.       exit;
  497.    txtpos := filepos(msgarearec.txtfile);
  498.    hdrpos := filepos(msgarearec.hdrfile);
  499.    filemode := fdenywrite + freadwrite;
  500.    changeaccess;
  501.    msghdrrec.startposition := filesize(msgarearec.txtfile);
  502.    with msgarearec.msgrec do
  503.       if (typ in [echomail,netmail]) then
  504.          msghdrrec.orignet := constant.netaddress[originaddress];
  505.    with msgarearec.msgrec do
  506.       if (typ in [localmail,allmail,echomail]) then
  507.          begin
  508.             msghdrrec.destnet.zone  := 0;
  509.             msghdrrec.destnet.net   := 0;
  510.             msghdrrec.destnet.node  := 0;
  511.             msghdrrec.destnet.point := 0;
  512.          end;
  513.    with msgarearec.msgrec do
  514.       begin
  515.          if (typ in [localmail,allmail]) then
  516.             msghdrrec.orignet := msghdrrec.destnet;
  517.          if (typ in [echomail,netmail]) then
  518.             addbeginlines else
  519.             makedate;
  520.          if (typ = echomail) then
  521.             begin
  522.                addendlines;
  523.                setbit(5,1,msghdrrec.msgattr); (* echomail pending export *)
  524.             end else
  525.          if (typ = netmail) then
  526.             setbit(1,1,msghdrrec.msgattr); (* netmail pending export *)
  527.       end;
  528.    inc(msghdrrec.messagelength);
  529.    msgtxtbuf[msghdrrec.messagelength] := #0;
  530.    seek(msgarearec.txtfile,filesize(msgarearec.txtfile));
  531.    blockwrite(msgarearec.txtfile,msgtxtrec,msghdrrec.messagelength,numwrote);
  532.    if (numwrote <> msghdrrec.messagelength) then
  533.       begin
  534.          seek(msgarearec.txtfile,msghdrrec.startposition);
  535.          truncate(msgarearec.txtfile);
  536.          filemode := fdenynone + freadonly;
  537.          changeaccess;
  538.          seek(msgarearec.hdrfile,hdrpos);
  539.          seek(msgarearec.txtfile,txtpos);
  540.          exit;
  541.       end;
  542.    if (msghdrrec.prevreply > 0) then
  543.       begin
  544.          seek(msgarearec.hdrfile,pred(msghdrrec.prevreply));
  545.          blockread(msgarearec.hdrfile,msgtmp,1);
  546.          while (msgtmp.nextreply > 0) and
  547.                (msgtmp.nextreply <> filepos(msgarearec.hdrfile)) and
  548.                (msgtmp.nextreply <= filesize(msgarearec.hdrfile)) do
  549.             begin
  550.                seek(msgarearec.hdrfile,pred(msgtmp.nextreply));
  551.                blockread(msgarearec.hdrfile,msgtmp,1);
  552.             end;
  553.          msgtmp.nextreply := filesize(msgarearec.hdrfile) + 1;
  554.          seek(msgarearec.hdrfile,filepos(msgarearec.hdrfile)-1);
  555.          blockwrite(msgarearec.hdrfile,msgtmp,1);
  556.          msghdrrec.prevreply := filepos(msgarearec.hdrfile);
  557.       end;
  558.    seek(msgarearec.hdrfile,filesize(msgarearec.hdrfile));
  559.    blockwrite(msgarearec.hdrfile,msghdrrec,1,numwrote);
  560.    if (numwrote <> 1) then
  561.       begin
  562.          seek(msgarearec.txtfile,msghdrrec.startposition);
  563.          truncate(msgarearec.txtfile);
  564.          filemode := fdenynone + freadonly;
  565.          changeaccess;
  566.          seek(msgarearec.hdrfile,pred(msghdrrec.prevreply));
  567.          blockread(msgarearec.hdrfile,msgtmp,1);
  568.          msgtmp.nextreply := 0;
  569.          seek(msgarearec.hdrfile,pred(msghdrrec.prevreply));
  570.          blockwrite(msgarearec.hdrfile,msgtmp,1);
  571.          seek(msgarearec.hdrfile,hdrpos);
  572.          seek(msgarearec.txtfile,txtpos);
  573.          exit;
  574.       end;
  575.    if (msgarearec.msgrec.typ in [echomail,netmail]) then
  576.       begin
  577.          tmpboolean := true;
  578.          if not fopen(tmpfile,sizeof(boolean),fdenynone + fwriteonly,
  579.                       configrec.msgpath + 'MSGEXPRT.BBS') then
  580.             exit;
  581.          seek(tmpfile,msgarearec.msgarea-1);
  582.          blockwrite(tmpfile,tmpboolean,sizeof(boolean));
  583.          close(tmpfile);
  584.          (* MSGEXPRT.BBS tells ezymail/ezynet which areas to scan for mail *)
  585.          if (msgarearec.msgrec.typ = echomail) then
  586.             echomailentered := true else
  587.             netmailentered  := true;
  588.       end;
  589.    addtofastmail;
  590.    updatemsgcount;
  591.    filemode := fdenynone + freadonly;
  592.    changeaccess;
  593.    writemessage := filepos(msgarearec.hdrfile);
  594.    seek(msgarearec.hdrfile,hdrpos);
  595.    seek(msgarearec.txtfile,txtpos);
  596. end;
  597.  
  598. function readmessage(var msgarearec : msgarearecord;
  599.                      msgtoread : word;
  600.                      var msghdrrec : msghdrrecord;
  601.                      var msgtxtrec;maxread : word;
  602.                      var numread : word) : boolean;
  603.  
  604. (*  Reads a message from a previously opened message area
  605.     msgtoread is the message number to read (record position + 1)
  606.     msghdrrec is the header record that will be returned
  607.     msgtxtrec is the message text information
  608.     maxread is the maximum amount of text in bytes that can be read
  609.     numread is the actual amount of text in bytes that is read
  610.  
  611.     If the amount of text read is less than the actual size of the
  612.     message, then this procedure will clean up the tail of the message
  613.     by inserting a carriage return and adding the null terminator
  614.  
  615.     On error, numread will be 0, indicating no message was read *)
  616.  
  617. var
  618.    msgtxtbuf : array[1..65000] of byte absolute msgtxtrec;
  619.  
  620. begin
  621.    numread := 0;
  622.    readmessage := false;
  623.    {$I-}
  624.    seek(msgarearec.hdrfile,msgtoread-1);
  625.    if (ioresult > 0) or (maxread > 65000) then
  626.       exit;
  627.    blockread(msgarearec.hdrfile,msghdrrec,1);
  628.    if (ioresult > 0) then
  629.       exit;
  630.    seek(msgarearec.txtfile,msghdrrec.startposition);
  631.    if (ioresult > 0) then
  632.       exit;
  633.    blockread(msgarearec.txtfile,msgtxtrec,maxread,numread);
  634.    if (ioresult > 0) then
  635.       begin
  636.          numread := 0;
  637.          exit;
  638.       end;
  639.    if (numread < msghdrrec.messagelength) then
  640.       begin
  641.          msgtxtbuf[numread-1] := $0D;
  642.          msgtxtbuf[numread]   := $00;
  643.       end;
  644.    readmessage := true;
  645. end;
  646.  
  647.  
  648. function retlastread(var lastreadfile : file;
  649.                          userrecord,
  650.                          messageboard : word) : word;
  651.  
  652. var
  653.    lastrd : word;
  654.  
  655. begin
  656.    seek(lastreadfile,longint(userrecord) * (longint(constant.maxmess) div 16) * longint(sizeof(userslastrecord)) +
  657.       (((messageboard - 1) div 16) * sizeof(userslastrecord) + 2) +
  658.       (messageboard-1) mod 16 * 2);
  659.    blockread(lastreadfile,lastrd,2);
  660.    retlastread := lastrd;
  661. end;
  662.  
  663. procedure writelastread(var lastreadfile : file;
  664.                          userrecord,
  665.                          messageboard,
  666.                          lastread : word);
  667.  
  668. begin
  669.    seek(lastreadfile,longint(userrecord) * (longint(constant.maxmess) div 16) * longint(sizeof(userslastrecord)) +
  670.       (((messageboard - 1) div 16) * sizeof(userslastrecord) + 2) +
  671.       (messageboard-1) mod 16 * 2);
  672.    blockwrite(lastreadfile,lastread,2);
  673. end;
  674.  
  675. function retcombinedarea(var lastreadfile : file;
  676.                              userrecord,
  677.                              messageboard : word) : boolean;
  678.  
  679. var
  680.    comb : word;
  681.  
  682. begin
  683.    seek(lastreadfile,longint(userrecord) * (longint(constant.maxmess) div 16) * longint(sizeof(userslastrecord)) +
  684.       ((messageboard - 1) div 16) * longint(sizeof(userslastrecord)));
  685.    blockread(lastreadfile,comb,2);
  686.    retcombinedarea := biton((messageboard-1) mod 16,comb);
  687. end;
  688.  
  689. procedure getmsgareacount(var msgareacount : msgareacounttype);
  690.  
  691. var
  692.    tmpfile : file;
  693.  
  694. begin
  695.    if fopen(tmpfile,sizeof(word),fdenynone + freadonly,
  696.       configrec.msgpath + 'MSGCOUNT.BBS') then
  697.       begin
  698.          blockread(tmpfile,msgareacount,maxmess);
  699.          close(tmpfile);
  700.       end;
  701. end;
  702.  
  703. function lockit(var f : file;var pos : word;var size : longint;locktype : byte) : boolean;
  704.  
  705. var
  706.    regs : registers;
  707.  
  708. begin
  709.    pos  := pos  * filerec(f).recsize;
  710.    size := size * filerec(f).recsize;
  711.    regs.ah := $5C;
  712.    regs.al := locktype;
  713.    regs.bx := filerec(f).handle;
  714.    regs.cx := hi(pos);
  715.    regs.dx := lo(pos);
  716.    regs.si := hi(size);
  717.    regs.di := lo(size);
  718.    intr($21,regs);
  719.    lockit := ((regs.flags and fcarry) = 0) or (regs.ax = 1);
  720. end;
  721.  
  722. function lock(var f : file;pos : word;size : longint) : boolean;
  723.  
  724. var
  725.    reg : registers;
  726.  
  727. begin
  728.    lock := lockit(f,pos,size,0);
  729. end;
  730.  
  731. function unlock(var f : file;pos : word;size : longint) : boolean;
  732.  
  733. var
  734.    reg : registers;
  735.  
  736. begin
  737.    unlock := lockit(f,pos,size,1);
  738. end;
  739.  
  740. begin
  741.    assign(msgrecfile,'');
  742. end.
  743.